00100	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200	C *** READS DATA FROM DSK FOR VARIOUS THINGS.
00300	C  LOAD WITH PRNTX.DO
00400	
00500		IMPLICIT INTEGER(A-Q,S-Z)
00600		REAL DIS,PWDS,DISX,A,B,STFF,CENTR,POS,BOT,TOP,TOP2
00700		COMMON /DL/IXRX,SAVER,NAME /FRMT/F78F(1),FA1(1),FA5(1),ASK
00950	C					   ↓↓↓↓↓ V IS FOR READIN ONLY
01000		COMMON /ALF/INP(72),ML /XRN/RN(3000),V(1000)
01050		1 /STF/RSTFAC(-3/4),RSTJ2 /PLTR/PLT,RHT,DIS
01150		1 /PTR/PWDS(250),ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
01250		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /POSI/STFF(-3/4),JJ2,POS
01400		EQUIVALENCE (J3,JQ(1)),(J5,JQ(3)),(R5,RJQ(3))
01500		1,(R6,RJQ(4)),(R7,RJQ(5)),(R9,RJQ(7)),(J10,JQ(8))
01600		1,(R4,RJQ(2)),(R3,RJQ(1)),(I1,INP(1)),(R8,RJQ(6))
01900		DATA IP/'P'/,FA1/'( A1)'/
01910	
01925		RPLT=-999.
01927	C  RPLT WILL BE FOR HEAVY STAFF LINES.
01930	23	TYPE 21
01940	21	FORMAT(' RESET BOTTOM? '$)
01950		ACCEPT FA1,K
01960		IF(K.EQ.'A')GO TO 124
01970		IF(K.EQ.'P')GO TO 123
01980	C  TYPE 'P' FOR PRIM FONT ONLY. 'A' FOR ALL, IF RESET IS NEEDED.
01985		GO TO 24
01990	123	JFONT=-1
02000		GO TO 23
02010	124	JFONT=0
02015		GO TO 23
02020	24	IF(K.EQ.'N')GO TO 22
02030	C 'Y' OR <CR>=ABSOLUTE LOW POINT OF FILE WILL BE AT
02040	C STARTING PEN POS.
02050	C 'N'= BOTTOM OF STAFF 0 WILL BE AT STARTING PEN POS.
02060		TOP2=-999
02080	MPRNT:	0
02090		MOVE 15,MPR+1	; K
02100		CAIN 15,"N"
02110		JRST MP22
02120		MOVN [999.0]
02130		MOVEM TOP2#
02140		SETZM RNOMOV#
02150	MP22:	SETZM ALF
02160	MP2:	MOVE [999.0]
02170		MOVNM DPY+1		;TOP
02180		MOVEM DPY+2		;BOT
02200		RNOMOV=0
02300	22	I1=0
02400	C  RESTART PROG. OR TYPE 'F' TO FINISH PLOTTER.(IT'S NOT AUTOMATIC.)
02700	2	TOP=-999
02800		BOT=999
02900	20	PLT=0
02910		PLOTIT=0
02920	MP20:	SETZM PLTR
02930		SETZM PLOTIT#
02940		SETOM EDX#
02950		MOVEI 1,1
02960		MOVEM 1,PTR+=253	; M
02970		JRST MP5504
03000	CC	PWDS(1)=1.
03100		EDX=-1
03200	CC	DO 1402 K=-3,4
03300	CC1402	RSTFAC(K)=1.
03400		M=1
03500	CC	ITEM=0
03700	CC	I=1
03900		GO TO 5504
04000	
04100	
04200	11	CALL NOTWRT
04210	MP11:	JSA 16,NOTWRT
04220	MP57:	SKIPGE PLTR
04230		JRST MP6120
04240		AOS PTR+=250	;ITEM
04250		MOVN EDX
04260		CAIN 1
04270		JRST MP77
04280		MOVE PTR+=253	; M
04290		CAMGE PTR+=252	; I
04295		JRST MP6120
04300	57	IF(PLT)GO TO 6120
04400		ITEM=ITEM+1
04500		IF(EDX.EQ.-1)GO TO 77
04550		IF(M.LT.I)GO TO 6120
04600	77	IF(PLOTIT.EQ.-2)GO TO 2311
04700	
04710	MP77:	MOVN PLOTIT
04720		CAIN 2
04730		JRST MP2311
04740	MP5504:	MOVEI "P"
04750		CAMN ALF
04760		JRST MP2311
04770		MOVEM ALF
04780		MOVEI "X"
04790		MOVEM ALF+1
05000	
05100	5504	IF(I1.EQ.IP)GO TO 2311
05320		I1=IP
05340		INP(2)='X'
05400	311	JA=0
05500	MP311:	SETZM .COMM.+1	; JA
05510	MP2311:	JSA 16,PLTCMD
05520		MOVE PLOTIT
05530		JUMPE MP3005
05540		MOVEI "P"
05550		MOVEM ALF
05560		SETOM PLOTIT
05600	2311	CALL PLTCMD
05700		IF(PLOTIT.EQ.0)GO TO 3005
05800		I1=IP
05900		PLOTIT=-1
06000	C  'PXG' OR 'PXC' GOES TO 'PLOT COMMAND' ROUTINE
06200	
06300	6531	M=1
06310	MP6531:	MOVEI 1
06320		MOVEM PTR+=253	: M
06330		SETOM EDX
06340		SETZ 1,		; K
06350	MP5532:	MOVE 4,.COMM.+4(1)
06360		FIXX(4)
06370		MOVEM 4,.COMM.+=24(1)
06380		CAIGE 1,=8
06390		AOJA 1,MP5532
06400		EDX=-1
06500		DO 5532 K=1,9
06600	5532	JQ(K)=RJQ(K)
06700		SETO 2,
06710		CAMN 2,PLOTIT
06720		JRST MP5121
06750		IF(PLOTIT.EQ.-1)GO TO 5121
06800	590	I1=0
07000	C TO RUN THROUGH DATA.
07200	MP590:	SETZM ALF
07210		MOVE [999.0]
07220		MOVNM DPY+1
07230		MOVEM DPY+2
07240	MP85:	MOVEI 1m
07250		MOVEM PTR+=253
07260		SETZM PTR+=250
07500		TOP=-999
07600		BOT=999
07700	C  GOES TO PLOTTER
07800	85	M=1
07900	CC	I=PWDS(ITEM+1)
08000		ITEM=0
08100	8852	PLT=1
08110	MP8852:	MOVEI 1
08120		MOVEM PLTR
08130		SETZM EDX
08140		JRST MP6120
08200		EDX=0
08400		GO TO 6120
08500	
08600	60	J2=R2
08700	MP60:	MOVE 1,.COMM.
08710		FIXX(1)
08720		MOVEM 1,.COMM.+3	; J2
08730		MOVE 2,STF-1(1)		; RSTFAC(J2)
08740		MOVEM 2,STF+=8		; RSTJ2
08750		MOVE 2,POSI-1(1)
08760		MOVEM 2,POSI+=9		; POS
08770		JSA 16,RHORZ
08780		JUMP .COMM.+4		; R3
08790		FIXX(0)
08800		MOVEM .COMM.+=24	; J3
08810		JSA 16,CENTX
08820		MOVE 3,.COMM.+=24
08830		TLC 3,232000
08840		FADR 3,3
08850		MOVEM 3,.COMM.+4
08860		MOVE 1,.COMM.+1
09050		RSTJ2=RSTFAC(J2)
09100	5541	POS=STFF(J2)
09110		IF(JA.NE.16)GO TO 61
09120		IF(J10.NE.1)GO TO 62
09130		R3=RWD3
09135	C  POSITIONS TEXT ITEMS.
09140	62	RWD3=R5*RSTJ2*R9+R3
09200	61	J3=ROFF(RHORZ(R3))
09300	C  LINE IS DIVIDED INTO 200 POINTS.
09400		CALL CENTX
09434	C  SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
09468		R3=J3
09501	
09502		IF(JA.LE.2)GO TO 11
09536	551	GO TO(11,11,68,25,67, 25,116,125,11,69, 68,67),JA
09570		GO TO (116,81,80),JA-15
09604	C  FOR 16,17,18 (WORDS, KSIG, METER)
09808	
09842	69	CALL MAKNUM(R5)
09876		GO TO 57
09910	
09944	68	CALL CLEFS
09978		GO TO 57
10012	
10046	67	CALL SLUR
10080		GO TO 57
10114	
10148	116	CALL ALPHA
10182		GO TO 57
10216	
10250	81	CALL KSIG
10284		GO TO 57
10318	
10352	80	CALL METER
10386		GO TO 57
10520	125	IF(R2.EQ.0)RMOV=R8
10556	25	CALL ITMSUB
10590	C   BAR LINES, BEAMS, STAFF LINES ****
10624		GO TO 57
10770		
10780		JRST .+0(1)
10790		JRST MP11
10800		JRST MP11
10810		JRST MP68
10820		JRST MP25
10830		JRST MP67
10840		JRST MP25
10850		JRST MP116
10860		JRST MP125
10870		JRST MP11
10880		JRST MP69
10890		JRST MP69
10900		JRST MP67
10910		0
10920		0
10930		0
10940		JRST MP116
10950		JRST MP81
10960		JSA 16,METER
10970		JRST MP57
11100	
11200	3005	REWIND 21
11300	C  GUARDS AGAINST LOSSAGE!
11350		IF(RPLT.EQ.-999.)RPLT=R9
11360	C R9=1 FOR HEAVY STAFF LINES. (FOR XGP)
11400		PLOTIT=-2
11500		CALL IFILE(21,NAME)
11600	C  JUMP TO READ BIG FILES
11700	CC2200	J=ITEM+1
11800	2202	READ(21),ITEM,I,(PWDS(K),K=1,ITEM+1),(RN(K),K=1,I-1)
11900		1 ,JA,(V(K),K=1,JA),JA,(V(K),K=1,JA),RSTFAC,STFF
12000		READ(21,END=2203)RSTFAC,STFF
12005	2203	IF(I.LE.2000)GO TO 590
12120		TYPE 4202,Y
12130		STOP
12140	4202	FORMAT(' ***** TOO MUCH DATA ',I4,'/2000')
12500	121	IF(PLOTIT.EQ.0)GO TO 5504
12600	5121	CALL PLTSRT
12700	C  IF P5=0 MOVES UP AT START, IF P6=0 MOVES UP AT END.
12800		PLT=-1
12850		IF(RPLT.NE.0)PLT=-2
12900	C  (J8) P8=1 OR 2 FOR 2-PASS PLOTS
13200	CC	IF(R2.EQ.0)R2=1.
13210		CALL NOZERO(R2)
13300		DIS=R2*1.24
13400	CXX	IF(R3.EQ.0)R3=R2
13500		RHT=R3*1.2
13600	C   1.24 AND 1.2 ARE TO FIT 8 1/2 X 11 FORMAT
13700		BOT=-BOT*RHT
13710	CX	IXGP=100+BOT
13800		IF(TOP2.EQ.-999)GO TO 8121
13900		BOT=BOT+TOP2
13950		IF(TOP2.EQ.0)BOT=0
14000		GO TO 9121
14200	8121	RNOMOV=0
14228	9121	IF(R7.EQ.0)R7=RMOV
14237	C RMOV HAS INCHES FROM P8 OF STAFF 0.
14246		IF(RNOMOV.GT.1)BOT=RNOMOV
14255		RNOMOV=R6+R7*200.*R3
14273		RMOV=0
14400	C  R6=1 FOR NO MOVE AT END.  R7=# OF INCHES TO MOVE FOR NEW STAFF 0.
14600	C (J4) P4=1 FOR XGP OUTPUT
14720		IF(J5.NE.0)GO TO 6120
15000	C  MOVES 0 POINT OVER EACH TIME.
15200	6121	CALL PLOT(0,IFIX(BOT),-3)
15300	C  MOVES PLOTTER UP IF P5=0.
15500	
15600	C  NEXT RUNS THROUGH DATA WITH NEW CHANGES.
15700	6120	IF(M.GE.I)GO TO 7120
15800		CALL RUNTHR(M)
17050		GO TO 60
17100	
17200	7120	M=1
17300	CZ	IF(EDX)GO TO 71201
17400	CZ	IF(PLT.EQ.1)EDX=-1
17500	CZ	PLT=0
17600	C  RETURNS FOR 'SL'=SAVE LAST
17700	CZ	GO TO 5504
17950	71201 	A=TOP*RHT+50.*RHT
18000		IF(RNOMOV.NE.0)A=0
18100		IF(RNOMOV.GT.1)A=RNOMOV
18200		CALL PLOT(0,IFIX(A),3)
18225		IF(RNOMOV.EQ.1)GO TO 20
18237	C  PRESERVES TOP AND BOT IF RNOMOV
18250	CX	CALL PLOT(0,TOP+IXGP,3)
18275		TOP=A
18300		TOP2=TOP
18400		GO TO 2
18500	C  TO MOVE 'PLOTTER' FOR XGP OUTPUT
18600	C  MOVES PLOTTER UP
18700	C  ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
18800	
19000		END